Analysis of New York City MTA Data During COVID-19 Pandamic

Data Source:
NYC published COVID-19 Data LINK
NYC published MTA Data LINK

---

How many subway riders everyday ?

Around 5 Million riders/day. Observed initial drop of rider around March 8th.

plot_ly(
  data = station_data_3,
  x = ~ date,
  y = ~ total_in_day,
  name = 'Day Riders',
  type = 'bar'
) %>%
  add_trace(
    x = ~ date,
    y = ~ total_in_day,
    type = 'scatter',
    mode = 'markers+lines',
    name = 'Weekly Avg',
    line = list(
      color = 'rgb(205, 12, 24)',
      width = 4,
      shape = "spline"
    ),
    opacity = 0.75,
    transforms = list(
      list(
        type = 'aggregate',
        groups = station_data_3$week_seq,
        aggregations = list(list(
          target = 'y',
          func = 'avg',
          enabled = T
        ))
      )
    )
  ) %>% layout( 
    title = "MYC MTA Ridership",
    xaxis = list(title = ""),
    yaxis = list(title = "# of People")
  )

How COVID-19 affected subway ridership ?

• Using daily confirmed cases

plot_ly(data = station_data_3) %>%
  add_trace(
    x = ~ date,
    y = ~ scale(total_in_day),
    type = 'scatter',
    mode = 'markers+lines',
    name = 'Weekly MTA Riderships',
    line = list(
      color = 'rgb(205, 12, 24)',
      width = 4,
      shape = "spline"
    ),
    opacity = 0.75,
    transforms = list(
      list(
        type = 'aggregate',
        groups = station_data_3$week_seq,
        aggregations = list(list(
          target = 'y',
          func = 'avg',
          enabled = T
        ))
      )
    )
  ) %>%
  add_trace(
    data = ny_covid,
    x = ~ date,
    y = ~ scaled_case,
    type = 'scatter',
    mode = 'markers+lines',
    name = 'NYC COVID-19 <br>New Confirmed Cases',
    line = list(# color = 'rgb(205, 12, 24)',
      width = 4,
      shape = "spline"),
    marker = list(color = 'RGB(64, 154, 203)')
  ) %>%
  add_segments(
    x = '2020-03-22',
    xend = '2020-03-22',
    y = -1.50,
    yend = 2,
    name = "NYC Stay At Home Order",
    line = list(
      dash = 'dot',
      width = 3,
      color = "#2ca02c"
    )
  ) %>% 
  layout( 
    title = "MTA vs COVID-19",
    xaxis = list(title = ""),
    yaxis = list(title = "Scaled Number"),
    legend = list(orientation = "v")
  )

• Using cumulative confirmed cases

plot_ly(data = station_data_3) %>%
  add_trace(
    x = ~ date,
    y = ~ total_in_day,
    type = 'scatter',
    mode = 'markers+lines',
    name = 'Weekly MTA Riderships',
    line = list(
      color = 'rgb(205, 12, 24)',
      width = 4,
      shape = "spline"
    ),
    opacity = 0.75,
    transforms = list(
      list(
        type = 'aggregate',
        groups = station_data_3$week_seq,
        aggregations = list(list(
          target = 'y',
          func = 'avg',
          enabled = T
        ))
      )
    )
  ) %>%
  add_trace(
    data = ny_covid,
    x = ~ date,
    y = ~ cumulative_case,
    yaxis = "y2",
    type = 'scatter',
    mode = 'markers+lines',
    name = 'NYC COVID-19 <br>Cumulative Cases',
    line = list(# color = 'rgb(205, 12, 24)',
      width = 4,
      shape = "spline"),
    marker = list(color = 'RGB(64, 154, 203)')
  ) %>%
  add_segments(
    x = '2020-03-22',
    xend = '2020-03-22',
    y = 400000,
    yend = 4500000,
    name = "NYC Stay At Home Order",
    line = list(
      dash = 'dot',
      width = 3,
      color = "#2ca02c"
    )
  ) %>%
  layout(
    title = "MTA vs COVID-19",
    legend = list(x = 0.05, y = 0.5),
    xaxis = list(title = "Date"),
    yaxis = list(title = "MTA Ridership"),
    yaxis2 = list(
      tickfont = list(color = "#d62728"),
      overlaying = "y",
      side = "right",
      title = "Cumulative COVID-19 Cases"
    ),
    margin = list(r = 120)
  )

NYC residents movement

How people move in NYC by subway, Red means people get outm Blue means people go in.

Noax <- list(
  title = "",
  zeroline = FALSE,
  showline = FALSE,
  showticklabels = FALSE,
  showgrid = FALSE
)

station_data_march = station_data_2[datetime  > "2020-03-01 00:00:00", ]
station_data_march[, timeCut := cut(datetime, breaks = "240 mins")]
pal <- c("grey", "blue", "red")
plot_ly(
  # data = head(station_data_2, 100000),
  data = station_data_march,
  type = "scatter",
  mode = "markers",
  x = ~ station_longitude ,
  y = ~ station_latitude,
  marker = list(size = ~ log((total_flow) + 0.1)),
  color = ~ in_out,
  colors = ~ pal,
  ids = ~ station_seq ,
  frame = ~ timeCut
) %>%
  layout(xaxis = Noax, yaxis = Noax) %>%
  animation_slider(currentvalue = list(
    prefix = "Time ",
    font = list(color = "red"),
    xanchor = "center"
  ))